perm filename IIIGO.SAI[GO,ALS] blob
sn#105685 filedate 1974-06-12 generic text, type T, neo UTF8
00100 BEGIN "GOMAIN"
00200
00300
00400 INTEGER SIMPLEMODE,RUNBEFORE;
00500 REQUIRE "GOEVAL" LOAD_MODULE;
00600 REQUIRE "GOLOOK" LOAD_MODULE;
00700 REQUIRE "GOFAIL" LOAD_MODULE;
00800 REQUIRE "GOMOVE" LOAD_MODULE;
00900
01000 STRING INSTR,GAMBUF,GARBAGE,STRNG1,INSTRG,STRNG;
01100
01200 INTERNAL STRING FSSTRG;
01300
01400 DEFINE CRLF="('15&'12)",LF="'12",TT="1",CHRSCN="2",
01500 FF="('15&'12&'14)",TAB="'11",CRLF2="(CRLF&CRLF)",
01600 CRLF3="(CRLF2&CRLF)",
01700 BLI="(IF I>8 THEN '101+I ELSE '100+I)",
01800 DSKI="3",DSKO="4",DSKTAB="3",LSTO="5",
01900 BLACK="'200000",WHITE="'400000",BLANK="'100000",NONOCC="'40000";
02000
02100 INTEGER NXTMOV,J,K,II,IJ,BRCHAR,ENDFIL,PLAYSELF,STKSET,LGTH,WCHDAT,
02200 FFLAG,L,STOPMV,SCORE,HDCP,ARWLGO,BITWRD,HALFWD,GB0123;
02300
02400 EXTERNAL INTEGER SENTE,ISEN,JSEN,LVL,I,SE,SF,PLAYER,ISAV,JSAV,
02500 KKK,LEXIST,CURI,CURJ;
02600
02700 PRELOAD_WITH 88,94,100,214,220,226,340,346,352,1000;
02800 SAFE INTERNAL INTEGER ARRAY HDCPNT[0:9],MSGDPY[0:49],BRDDPY[0:99],
02900 PNTDPY[0:599];
03000
03100 SAFE EXTERNAL INTEGER ARRAY XGB3,XGB1,XGBOAR[0:440],XSTKSR[-2:99],
03200 ADJWGT,BLSAVE,WHSAVE,DIFWGT,FRDWGT,ENMWGT,BLDATA,WHDATA[0:35],
03300 XSTRPT[0:255],XGRPPT[-3:149],ARMIES,WALLS[-3:99],MSCVAL[0:35],
03400 MSCWGT,KLLWGT,LIVWGT[0:35],SCRFRV,SCRENV[0:16],XAREAP[0:50],
03500 XGB2[0:442],LBONUS[0:17];
03600
03700 INTERNAL INTEGER MOVENO,TTYGUY,KOTAC,OUTPON,GAMVAL,BOARDS,IIIDPY,MOVETIME;
03800
03900 INTERNAL INTEGER NDXFOR,PFORCE,IFORCE,JFORCE,IFOR,JFOR,KFOR;
04000
04100 PRELOAD_WITH "INFLUENCE","BASE SCORE","DELT SCORE","ARMIES","WALLS",
04200 "GROUPS","STRINGS","AREA","POINT","OCTLS";
04300 SAFE STRING ARRAY DPTITL[1:10];
04400
04500 EXTERNAL INTEGER PROCEDURE GBFGET(INTEGER INDEX);
04600 EXTERNAL INTEGER PROCEDURE GBEGET(INTEGER INDEX);
04700 EXTERNAL INTEGER PROCEDURE INFLPT(INTEGER INDEX);
04800 EXTERNAL PROCEDURE GBFPUT(INTEGER VALU,NDX);
04900 EXTERNAL PROCEDURE GBEPUT(INTEGER VALU,NDX);
05000 EXTERNAL PROCEDURE CONSET;
05100 EXTERNAL PROCEDURE SCRUPD;
05200 EXTERNAL INTEGER PROCEDURE IIISET;
05300 EXTERNAL INTEGER PROCEDURE STRATEVAL(INTEGER I,PLAYER,ISRT,ISTP);
05400 EXTERNAL PROCEDURE LADDERSET(INTEGER STRNGNO);
05500 EXTERNAL PROCEDURE REDOST(INTEGER I,J);
05600
05700 REQUIRE "IIIDPY" LOAD_MODULE;
05800 EXTERNAL PROCEDURE DPYSET(INTEGER ARRAY DPYBUF);
05900 EXTERNAL PROCEDURE AIVECT(INTEGER X,Y);
06000 EXTERNAL PROCEDURE AVECT(INTEGER X,Y);
06100 EXTERNAL PROCEDURE APOINT(INTEGER X,Y);
06200 EXTERNAL PROCEDURE DPYBIG(INTEGER SIZE);
06300 EXTERNAL PROCEDURE DPYBRT(INTEGER BRT);
06400 EXTERNAL PROCEDURE DPYSST(STRING STR);
06500 EXTERNAL PROCEDURE DPYOUT(INTEGER POG);
06600 EXTERNAL PROCEDURE HYDPOG(INTEGER POG);
06700 EXTERNAL PROCEDURE TYPLOC(INTEGER FLINE,LLINE);
06800
06900 PROCEDURE ALINE(INTEGER I,J,K,L); BEGIN
07000 AIVECT(I,J); AVECT(K,L) END;
07100 PROCEDURE DPYSVS(INTEGER X,Y;STRING S); BEGIN
07200 AIVECT(X,Y); DPYSST(S); END;
07300
07400
07500
07600
07700
07800 INTERNAL PROCEDURE HEDOUT(INTEGER DVCE);
07900 BEGIN COMMENT
08000 **********WRITE A GENERAL-PURPOSE HEADER*****;
08100 INTEGER YEAR,MONTH,DAY;
08200 OUT(DVCE,GAMBUF[1 TO 20]); OUT(DVCE,TAB&TAB&"MOVE");
08300 SETFORMAT(4,7); OUT(DVCE,CVS(MOVENO)); OUT(DVCE,TAB);
08400 YEAR←CALL(0,"DATE"); DAY←(YEAR MOD 31)+1; MONTH←YEAR DIV 31;
08500 YEAR←(MONTH DIV 12)+64; MONTH←(MONTH MOD 12)+1;
08600 OUT(DVCE,CVS(MONTH)); OUT(DVCE,CVS(DAY)); OUT(DVCE,CVS(YEAR));
08700 OUT(DVCE,TAB); OUT(DVCE,CVS(CALL(0,"RUNTIM")));
08800 SETFORMAT(0,7);
08900 END;
09000
09100
09200 INTERNAL STRING PROCEDURE BLIJ(INTEGER I,J);
09300 BEGIN COMMENT SET UP 5-CHARACTER STRING OF COORDINATES;
09400 INTEGER IWRD;
09500 IWRD←((('40 LSH 7)+'40) LSH 7)+BLI;
09600 IWRD←(IWRD LSH 14)+(('40 LSH 7)+'60);
09700 IWRD←J+(IF J<10 THEN IWRD ELSE (IWRD LSH 7)+'246);
09800 RETURN(CVSTR(IWRD LSH 1));
09900 END;
10000
10100
10200 PROCEDURE MBW;
10300 BEGIN COMMENT PROMPT TTY FOR ANOTHER MOVE INPUT;
10400 SETFORMAT(6,7); OUT(TT,CVS(MOVENO)); SETFORMAT(0,7);
10500 IF MOVENO LAND 1 THEN OUT(TT,TAB&"B: ") ELSE OUT(TT,TAB&"W* ");
10600 END;
10700
10800
10900
11000
11100
11200 INTEGER PROCEDURE COORDGET;
11300 BEGIN COMMENT
11400
11500 **********
11600 RETURN THE DECIMAL VALUE OF A MOVE COORDINATE WHETHER
11700 IT IS A LETTER, A ONE-DIGIT NUMBER, OR A TWO-DIGIT
11800 NUMBER.
11900 **********;
12000
12100 BRCHAR←" ";
12200 WHILE BRCHAR=" " DO K←SCAN(INSTRG,CHRSCN,BRCHAR);
12300
12400 IF "0"≤BRCHAR≤"9" THEN BEGIN
12500 J←BRCHAR-"0";
12600 K←SCAN(INSTRG,CHRSCN,BRCHAR);
12700 IF "0"≤BRCHAR≤"9" THEN RETURN(10*J+BRCHAR-"0")
12800 ELSE BEGIN INSTRG←BRCHAR&INSTRG; RETURN(J); END;
12900 END;
13000 RETURN(IF "J"≤BRCHAR≤"T" THEN BRCHAR-"A"
13100 ELSE IF"A"≤BRCHAR≤"I" THEN BRCHAR-'100 ELSE 0);
13200 END; COMMENT COORDGET;
13300
13400
13500
13600
13700
13800 PROCEDURE OPENDISK(INTEGER CHANL,MODE;STRING FILNAM);
13900 BEGIN COMMENT
14000
14100 **********OPEN DISK OUTPUT FILE**********;
14200
14300 OPEN(CHANL,"DSK",MODE,0,2,0,BRCHAR,ENDFIL);
14400 ENTER(CHANL,FILNAM,FFLAG);
14500 IF FFLAG THEN OUT(TT,"NO ROOM ON DISK"&CRLF);
14600 END;
14700
14800
14900
15000
15100
15200 INTEGER PROCEDURE ODSKOPN(INTEGER CHANL;STRING FILNAM);
15300 BEGIN COMMENT
15400
15500 **********CHECK DISK FOR PRESENCE OF A FILE**********;
15600
15700 OPEN(CHANL,"DSK",0,2,0,200,BRCHAR,ENDFIL);
15800 LOOKUP(CHANL,FILNAM,FFLAG);
15900 CLOSE(CHANL); RELEASE(CHANL);
16000 IF FFLAG THEN BEGIN
16100 OPENDISK(CHANL,0,FILNAM); RETURN(1);
16200 END ELSE RETURN(0);
16300 END;
16400
16500
16600
16700
16800
16900 EXTERNAL PROCEDURE AWUPDA;
17000 EXTERNAL PROCEDURE AREA;
17100 EXTERNAL PROCEDURE UNMOVE;
17200 EXTERNAL INTEGER PROCEDURE LEGAL(INTEGER I,J,MVNO);
17300 EXTERNAL PROCEDURE UPDAT;
17400 EXTERNAL PROCEDURE EVAL;
17500
17600
17700
17800
17900
18000 PROCEDURE HOLDVALS;
18100 BEGIN COMMENT
18200 **********SAVE A BUNCH OF COEFFICIENTS**********;
18300 OPENDISK(DSKO,8,GAMBUF[1 TO 6]&".COF");
18400 ARRYOUT(DSKO,ADJWGT[0],36);
18500 ARRYOUT(DSKO,DIFWGT[0],36);
18600 ARRYOUT(DSKO,ENMWGT[0],36);
18700 ARRYOUT(DSKO,FRDWGT[0],36);
18800 ARRYOUT(DSKO,KLLWGT[0],36);
18900 ARRYOUT(DSKO,LIVWGT[0],36);
19000 ARRYOUT(DSKO,MSCVAL[0],36);
19100 ARRYOUT(DSKO,MSCWGT[0],36);
19200 ARRYOUT(DSKO,XGB2[0],441);
19300 ARRYOUT(DSKO,LBONUS[0],18);
19400 CLOSE(DSKO); RELEASE(DSKO);
19500 END;
19600
19700
19800
19900
20000
20100 PROCEDURE RESTVALS;
20200 BEGIN COMMENT
20300 **********UNDO HOLDVALS**********;
20400 ARWLGO←2;
20500 OUT(TT,"COEFF FILE (<CR> TO SAVE PRESENT COEFFICIENTS):");
20600 STRNG←INPUT(TT,TT);
20700 IF LENGTH(STRNG)=0 THEN BEGIN SCRUPD; RETURN END;
20800 OPEN(DSKI,"DSK",8,2,0,200,BRCHAR,ENDFIL);
20900 LOOKUP(DSKI,STRNG&".COF",FFLAG);
21000 IF FFLAG THEN OUT(TT,"CAN'T FIND FILE"&CRLF)
21100 ELSE BEGIN
21200 ARRYIN(DSKI,ADJWGT[0],36);
21300 ARRYIN(DSKI,DIFWGT[0],36);
21400 ARRYIN(DSKI,ENMWGT[0],36);
21500 ARRYIN(DSKI,FRDWGT[0],36);
21600 ARRYIN(DSKI,KLLWGT[0],36);
21700 ARRYIN(DSKI,LIVWGT[0],36);
21800 ARRYIN(DSKI,MSCVAL[0],36);
21900 ARRYIN(DSKI,MSCWGT[0],36);
22000 ARRYIN(DSKI,XGB2[0],441);
22100 ARRYIN(DSKI,LBONUS[0],18);
22200 SCRUPD;
22300 END;
22400 CLOSE(DSKI); RELEASE(DSKI)
22500 END;
22600
22700
22800
22900
23000
23100 BOOLEAN PROCEDURE SETSIDES;
23200 BEGIN COMMENT DEFINE WHICH SIDE IS WHICH FOR PLAYING OR DISPLAYING;
23300 LABEL PIKSID;
23400 PIKSID:OUT(TT,"PICK SIDE, B OR W:"); STRNG←INPUT(TT,TT);
23500 K←SCAN(STRNG,CHRSCN,BRCHAR); PLAYSELF←0;
23600 IF BRCHAR="B" THEN TTYGUY←1
23700 ELSE IF BRCHAR="W" THEN TTYGUY←0
23800 ELSE IF BRCHAR="X" THEN BEGIN
23900 PLAYSELF←1; TTYGUY←(MOVENO+1) LAND 1;
24000 OUT(TT,"UNTIL MOVE:"); STOPMV←CVD(INPUT(TT,TT));
24100 IF MOVENO≥STOPMV THEN RETURN(FALSE);
24200 END ELSE GO TO PIKSID;
24300 RETURN(TRUE);
24400 END;
00100 STRING PROCEDURE VALFLN;
00200 RETURN(CVS(K)&" DELT="&CVS(GBFGET(SCRFRV[K]))&" "&
00300 BLIJ(SCRFRV[K] DIV 21,SCRFRV[K] MOD 21));
00400 STRING PROCEDURE VALELN;
00500 RETURN(CVS(K)&" BASE="&CVS(GBEGET(SCRENV[K]))&" "&
00600 BLIJ(SCRENV[K] DIV 21,SCRENV[K] MOD 21));
00700
00800 INTERNAL PROCEDURE VALOUT(INTEGER NBR);
00900 IF OUTPON THEN BEGIN COMMENT
01000 *****WRITE A HARD COPY OF THE VALUED MOVES*****;
01100 IF NBR=15 THEN BEGIN
01200 OUT(LSTO,CRLF3); OUT(LSTO,(IF TTYGUY THEN "W " ELSE "B "));
01300 HEDOUT(LSTO); OUT(LSTO,CRLF3);
01400 END;
01500 SETFORMAT(6,7);
01600 FOR K←1 STEP 1 UNTIL NBR DO
01700 OUT(LSTO,VALELN&(TAB&TAB)&VALFLN&CRLF);
01800 OUT(LSTO,CRLF&"GAMVAL"&CVS(GAMVAL)&CRLF2);
01900 SETFORMAT(0,7);
02000 END;
02100
02200 PROCEDURE DPYVAL;
02300 BEGIN COMMENT
02400 **********DISPLAY 15 MOST VALUED MOVES**********;
02500 HYDPOG(1); SETFORMAT(6,7);
02600 DPYSET(PNTDPY); DPYBRT(3); DPYBIG(2);
02700 FOR K←1 STEP 1 UNTIL 15 DO
02800 DPYSVS(-500,450-30*K,VALELN&" "&VALFLN);
02900 DPYSVS(-350,-45,"GAMVAL"&CVS(GAMVAL));
03000 DPYOUT(2); SETFORMAT(0,7);
03100 END;
03200
03300 PROCEDURE GRDSET(INTEGER ISRT,ISTP,JSRT,JSTP,MSG);
03400 BEGIN COMMENT
03500 **********SET UP AND OUTPUT BOARD GRID**********;
03600 DPYBRT(5); DPYBIG(2);
03700 IF 1≤MSG≤10 THEN DPYSVS(-500,445,DPTITL[MSG]);
03800 DPYBRT(2); K←JSRT-18*JSTP-7; L←ISRT+18*ISTP+7;
03900 FOR I←0 STEP 1 UNTIL 18 DO BEGIN
04000 II←ISRT+I*ISTP; IJ←JSRT-I*JSTP;
04100 ALINE(II,JSRT+7,II,K); ALINE(ISRT-7,IJ,L,IJ);
04200 END;
04300 IF MSG≠0 THEN DPYOUT(1);
04400 END;
04500
04600 PROCEDURE GRDSETO(INTEGER A,B,C,D,E); BEGIN
04700 DPYSET(BRDDPY); GRDSET(A,B,C,D,E); DPYOUT(1) END;
04800
04900 STRING PROCEDURE BRDLIN(STRING HCP,BNK,BLK,WHT,NOC);
05000 BEGIN COMMENT
05100 **********SET UP BOARD LINE OUTPUT STRING**********;
05200 INTEGER XXX;
05300 K←21*I+20; STRNG←NULL;
05400 FOR J←K-20 STEP 1 UNTIL K DO BEGIN
05500 XXX←CASE GB0123 OF (XGBOAR[J],XGB1[J],XGB2[J],XGB3[J]);
05600 STRNG←STRNG&(IF ((XXX≠-1)∧(XXX LAND BITWRD)) THEN "↑" ELSE " ");
05700 IF XGB1[J] LAND NONOCC THEN STRNG←STRNG&NOC
05800 ELSE IF XGB1[J] LAND BLANK THEN BEGIN
05900 WHILE J>HDCPNT[L] DO L←L+1;
06000 STRNG←STRNG&(IF J=HDCPNT[L] THEN HCP ELSE BNK);
06100 END ELSE STRNG←STRNG&(IF XGB1[J] LAND BLACK THEN BLK ELSE WHT);
06200 END;
06300 RETURN(STRNG);
06400 END;
06500
06600 INTERNAL PROCEDURE BRDOUT;
06700 IF OUTPON THEN BEGIN COMMENT
06800 **********HARD COPY OF BOARD*****;
06900 L←0;
07000 OUT(LSTO,FF); HEDOUT(LSTO); OUT(LSTO,CRLF3);
07100 FOR I←0 STEP 1 UNTIL 20 DO
07200 OUT(LSTO,BRDLIN("# ","+ ","B ","W "," ")&CRLF);
07300 OUT(LSTO,CRLF2);
07400 END;
07500
07600 PROCEDURE DPYBRD;BEGIN
07700 IF (IIIDPY≠0) THEN RETURN;
07800 IIIDPY←IIISET LAND '400000000000;
07900 IF ¬IIIDPY THEN RETURN;
08000 COMMENT
08100 **********DISPLAY BOARD POSITION ON SCOPE**********;
08200 DPYSET(PNTDPY);
08300 HYDPOG(3);
08400 DPYBRT(6); DPYBIG(4);
08500 L←0;
08600 FOR I←0 STEP 1 UNTIL 20 DO
08700 DPYSVS(-445,437-28*I,BRDLIN("*"," ","B","W"," "));
08800 GRDSET(-380,32,420,28,0);
08900 IF BITWRD=0 THEN BEGIN
09000 DPYBRT(2); DPYBIG(3);
09100 FOR I←1 STEP 1 UNTIL 19 DO BEGIN
09200 STRNG←BLI;
09300 J←439-28*I;
09400 K←32*I-(IF I>9 THEN 435 ELSE 430);
09500 DPYSVS(-430,J,STRNG); DPYSVS(215,J,STRNG);
09600 DPYSVS(K,430,STRNG←CVS(I)); DPYSVS(K,-120,STRNG);
09700 END;
09800 END;
09900 DPYOUT(2);
10000 END;
10100
10200 STRING PROCEDURE CVOCT(INTEGER WRD);
10300 BEGIN
10400 INTEGER WID,DIG; STRING STR;
10500 STR←CVOS(WRD LSH -18);
10600 GETFORMAT(WID,DIG); SETFORMAT(0,7);
10700 STR←STR&"."&CVOS(WRD LAND '777777);
10800 SETFORMAT(WID,DIG); RETURN(STR);
10900 END;
11000 STRING PROCEDURE WORDG(INTEGER WRD);
11100 RETURN(CVS(WRD LSH -30)&CVS((WRD LSH -24) LAND '77)&
11200 CVS((WRD LSH -18) LAND '77)&CVS((WRD LSH -7) LAND '177)&
11300 CVS(WRD LAND '177));
11400 STRING PROCEDURE OCTWRD(INTEGER I);
11500 RETURN(CVOCT(XGBOAR[I])&" "&CVOCT(XGB1[I])&" "&CVS(GBEGET(I))&
11600 " "&CVS(GBFGET(I))&" "&CVOCT(XGB3[I]));
11700 STRING PROCEDURE WORDA(INTEGER WRD);
11800 RETURN(CVS(WRD DIV 262144)&CVS((WRD LSH -9) LAND '777)&
11900 CVS(K←WRD LAND '777));
12000 STRING PROCEDURE WORDB(INTEGER WRD);
12100 RETURN(CVS(WRD LSH -27)&CVS(L←(WRD LSH -18) LAND '777)&
12200 CVS((WRD LSH -9) LAND '777)&CVS(WRD LAND '777));
12300 STRING PROCEDURE BWADD;
12400 RETURN(IF XGB1[J] LAND BLACK THEN "B" ELSE
12500 IF XGB1[J] LAND WHITE THEN "W" ELSE " ");
12600
12700 STRING PROCEDURE HAFWRD;
12800 BEGIN COMMENT *****PRODUCE HALFWORD VALUE AT POINT J*****;
12900 STRNG1←CVS(L←CASE HALFWD OF (INFLPT(J),GBEGET(J),GBFGET(J)));
13000 IF LENGTH(STRNG1)>LGTH THEN STRNG1←STRNG1[1 TO LGTH-1]&"@";
13100 IF (L=0)∨(L<-50000) THEN BEGIN
13200 STRNG1←NULL; FOR L←1 STEP 1 UNTIL LGTH DO STRNG1←STRNG1&" ";
13300 END;
13400 RETURN(STRNG1&BWADD);
13500 END;
13600
13700 STRING PROCEDURE INFLIN;
13800 BEGIN COMMENT ***INFLUENCE LINE***;
13900 STRNG←NULL; IJ←21*I+20;
14000 FOR J←IJ-20 STEP 1 UNTIL IJ DO STRNG←STRNG&HAFWRD;
14100 RETURN(STRNG);
14200 END;
14300
14400 STRING PROCEDURE GB2LIN;
14500 BEGIN COMMENT ***GB2 (SCORE) LINE***;
14600 STRNG←NULL; IJ←21*I+19;
14700 FOR J←IJ-18 STEP 1 UNTIL IJ DO STRNG←STRNG&HAFWRD;
14800 RETURN(STRNG);
14900 END;
15000
15100 STRING PROCEDURE BTSLIN;
15200 BEGIN COMMENT *****ISOLATE A SET OF BITS FROM A LINE OF GB1*****;
15300 STRNG←NULL; IJ←21*I+20;
15400 FOR J←IJ-20 STEP 1 UNTIL IJ DO BEGIN
15500 L←(XGB1[J] LSH (CASE HALFWD OF (-24,-18,-7,0,-30)))
15600 LAND (K←CASE HALFWD OF ('77,'77,'177,'177,'77));
15700 IF (L=0)∨(L=K) THEN FOR L←1 STEP 1 UNTIL LGTH DO STRNG←STRNG&" "
15800 ELSE STRNG←STRNG&CVS(L);
15900 STRNG←STRNG&BWADD;
16000 END;
16100 RETURN(STRNG);
16200 END;
16300
16400 PROCEDURE HAFOUT;
16500 BEGIN COMMENT
16600 **********DISPLAY HALFWORD OUTPUT**********;
16700 OUT(TT,"HALFWORD:"); INSTRG←INPUT(TT,TT);
16800 IF (LENGTH(INSTRG)>0)∧(0≤(HALFWD←CVD(INSTRG))≤2) THEN BEGIN
16900 IF HALFWD THEN BEGIN
17000 SETFORMAT(LGTH←5,7); GRDSETO(-432,48,410,28,HALFWD+1);
17100 DPYSET(PNTDPY); DPYBRT(4); DPYBIG(1);
17200 FOR I←1 STEP 1 UNTIL 19 DO DPYSVS(-465,436-28*I,GB2LIN);
17300 END ELSE BEGIN
17400 SETFORMAT(LGTH←4,7); GRDSETO(-400,40,400,28,1);
17500 DPYSET(PNTDPY); DPYBRT(4); DPYBIG(1);
17600 FOR I←0 STEP 1 UNTIL 20 DO DPYSVS(-475,416-28*I,INFLIN);
17700 END;
17800 SETFORMAT(0,7); DPYOUT(2);
17900 END;
18000 END;
18100
18200 PROCEDURE BTSOUT;
18300 BEGIN COMMENT
18400 **********DISPLAY PIECES OF GB1--AAWGS---**********;
18500 LABEL BTSOLP;
18600 BTSOLP:OUT(TT,"BITSWD:"); INSTRG←INPUT(TT,TT);
18700 IF (LENGTH(INSTRG)>0)∧(0≤(HALFWD←CVD(INSTRG))≤4) THEN BEGIN
18800 OUT(TT,"UPDATE??");
18900 IF INPUT(TT,TT)="Y" THEN BEGIN AREA; AWUPDA; END;
19000 GRDSETO(-400,40,400,28,HALFWD+4); SETFORMAT(LGTH←4,7);
19100 DPYSET(PNTDPY); DPYBRT(4); DPYBIG(1);
19200 FOR I←0 STEP 1 UNTIL 20 DO DPYSVS(-475,416-28*I,BTSLIN);
19300 SETFORMAT(0,7); DPYOUT(2); GO TO BTSOLP;
19400 END;
19500 END;
19600
19700 STRING PROCEDURE DATLIN;
19800 BEGIN COMMENT ***DESCRIPTORS FROM INTERNAL DATA STRUCTURE***;
19900 STRNG←CVS(I)&DPTITL[WCHDAT+4];
20000 CASE WCHDAT OF BEGIN
20100 IF 0<I<50 THEN
20200 STRNG1←WORDA(ARMIES[I])&WORDA(ARMIES[I+50]) ELSE K←0;
20300 IF 0<I<50 THEN
20400 STRNG1←WORDA(WALLS[I])&WORDA(WALLS[I+50]) ELSE K←0;
20500 IF 0<I<50 THEN BEGIN
20600 STRNG1←WORDA(XGRPPT[I])&WORDB(XGRPPT[I+50])
20700 &WORDB(XGRPPT[I+100]);
20800 K←XGRPPT[I+50] LAND '777;
20900 END ELSE K←0;
21000 IF 0<I<127 THEN BEGIN
21100 STRNG1←WORDB(XSTRPT[I])&" "&CVOCT(XSTRPT[I+128]); K←L;
21200 END ELSE K←0;
21300 IF 0<I≤50 THEN BEGIN STRNG1←WORDB(XAREAP[I]); K←L; END ELSE K←0;
21400 IF 0≤I≤440 THEN BEGIN STRNG1←WORDG(XGB1[I]); K←1; END ELSE K←0;
21500 IF 0≤I≤440 THEN BEGIN STRNG1←OCTWRD(I); K←1; END ELSE K←0;
21600 END;
21700 RETURN(STRNG&(IF K THEN STRNG1 ELSE "**UNDEFINED**"));
21800 END;
21900
22000 PROCEDURE DPYDAT;
22100 BEGIN COMMENT ***EXAMINE INTERNAL DATA STRUCTURE***;
22200 LABEL LP1DAT;
22300 SETFORMAT(6,7);
22400 LP1DAT:OUT(TT,"WHICH"); INSTRG←INPUT(TT,TT);
22500 IF (LENGTH(INSTRG)>0)∧(0≤(WCHDAT←CVD(INSTRG))≤6) THEN BEGIN
22600 LABEL LP2DAT;
22700 LP2DAT: OUT(TT,"#"); INSTRG←INPUT(TT,TT);
22800 IF LENGTH(INSTRG)>0 THEN BEGIN
22900 I←IF WCHDAT>4 THEN COORDGET*21+COORDGET ELSE CVD(INSTRG);
23000 DPYSET(MSGDPY); DPYBRT(2); DPYBIG(2);
23100 DPYSVS(-475,-170,DATLIN);
23200 IF (WCHDAT<5)∧(K≠0)
23300 THEN DPYSVS(-400,-190,BLIJ(K DIV 21,K MOD 21));
23400 DPYOUT(3); GO TO LP2DAT;
23500 END;
23600 GO TO LP1DAT;
23700 END;
23800 SETFORMAT(0,7);
23900 END;
00100 PROCEDURE SETOUTPUT;
00200 BEGIN COMMENT
00300
00400 **********SET UP AUTOMATIC TRACING OUTPUT**********;
00500 OUT(TT,"SET OUTPUT: "); INSTRG←INPUT(TT,TT);
00600 IF (OUTPON←OUTPON LAND 1) THEN BEGIN
00700 LABEL OUTPLP;
00800 OUTPLP: K←SCAN(INSTRG,CHRSCN,BRCHAR);
00900 IF BRCHAR="E" THEN BEGIN OUTPON←OUTPON LOR '1000; DPYBRD; END;
01000 IF BRCHAR="D" THEN OUTPON←OUTPON LOR '4000;
01100 IF BRCHAR="B" THEN OUTPON←OUTPON LOR '10000;
01200 IF BRCHAR="V" THEN OUTPON←OUTPON LOR '20000;
01300 IF BRCHAR="F" THEN OUTPON←OUTPON LOR '40000;
01400 IF BRCHAR THEN GO TO OUTPLP;
01500 END ELSE OUT(TT,"NO DSK FILE");
01600 END; COMMENT SETOUTPUT;
01700
01800
01900
02000
02100
02200 PROCEDURE DOOUTPUT;
02300 IF ¬SIMPLEMODE ∧ OUTPON LAND '1000 THEN
02400 OUT(TT,TAB&TAB&"S="&CVS(GAMVAL)&TAB&"T="&CVS(MOVETIME)&
02500 TAB&"B="&CVS(BOARDS)&CRLF);
02600
02700
02800
02900
03000
03100 BOOLEAN PROCEDURE LGLMOV(INTEGER I,J,ADDMOVE);
03200 BEGIN COMMENT
03300
03400 **********
03500 LGLMOV ENTERS MOVES INTO THE GAME RECORD AND MANAGES THE
03600 MOVE TRACE. IF AN ILLEGAL MOVE IS ATTEMPTED, IT IS NOT
03700 RECORDED AND LGLMOV GIVES A DIAGNOSTIC.
03800 **********;
03900
04000 CASE LEGAL(I,J,MOVENO) OF BEGIN
04100 BEGIN
04200 IF ADDMOVE THEN BEGIN
04300 IF LENGTH(GAMBUF)<NXTMOV THEN GAMBUF←GAMBUF&I&J
04400 ELSE GAMBUF←GAMBUF[1 TO NXTMOV-1]&I&J&
04500 GAMBUF[NXTMOV+2 TO ∞];
04600 END;
04700 NXTMOV←NXTMOV+2; MOVENO←MOVENO+1;
04800 REDOST(I,J); COMMENT FIND STRINGS AFFECTED;
04900 IF STKSET∨(XSTKSR[-1]>(-10 LSH 18)) THEN XSTKSR[-1]←XSTKSR[-2];
05000 IF OUTPON>1 THEN DOOUTPUT; RETURN(TRUE);
05100 END; COMMENT MOVE WAS LEGAL;
05200 OUT(TT,"BAD COORDS:");
05300 OUT(TT,"KO ERROR:");
05400 OUT(TT,"POINT OCCUPIED:");
05500 OUT(TT,"SUICIDE:");
05600 OUT(TT,"A-W-S OVERFLOW");
05700 END; COMMENT MOVE CASES;
05800 OUT(TT,BLIJ(I,J)); OUT(TT,CRLF); RETURN(FALSE);
05900 END; COMMENT LGLMOV;
06000
06100
06200
06300
06400
06500 COMMENT THIS IS USED TO SET PARMS BY Q COMMAND;
06600 PROCEDURE VARSETS(REFERENCE INTEGER ARRAY X;STRING S;INTEGER NDX);
06700 FOR I←CVD(INSTR) STEP 1 UNTIL NDX DO BEGIN
06800 OUT(TT,CVS(X[I])&TAB&S&"["&CVS(I)&"]: ");
06900 STRNG←INPUT(TT,TT);
07000 IF BRCHAR='175 THEN RETURN;
07100 IF LENGTH(STRNG)>0 THEN X[I]←CVD(STRNG);
07200 END;
07300
07400
07500
07600
07700
07800 PROCEDURE H2;
07900 BEGIN
08000 I←LEGAL(16,4,1)+LEGAL(4,16,1);
08100 IF LENGTH(GAMBUF)=20 THEN GAMBUF←GAMBUF&(HDCP+50)&(HDCP+50);
08200 NXTMOV←NXTMOV+2; MOVENO←MOVENO+1; XSTKSR[-1]←XSTKSR[-2];
08300 END;
08400 PROCEDURE H4;
08500 BEGIN I←LEGAL(4,4,1)+LEGAL(16,16,1); H2; END;
08600 PROCEDURE H6;
08700 BEGIN I←LEGAL(10,4,1)+LEGAL(10,16,1); H4; END;
08800 PROCEDURE H8;
08900 BEGIN I←LEGAL(4,10,1)+LEGAL(16,10,1); H6; END;
09000
09100
09200 PROCEDURE UPDO(INTEGER UPDA);
09300 BEGIN COMMENT
09400 **********
09500 CARRY OUT THE INITIAL UPDATING PROCESS ACCORDING TO DIRECTION
09600 FROM EITHER UPSTRT OR THE "C" (CONTINUE) COMMAND.
09700 **********;
09800 CASE HDCP OF BEGIN
09900 ; ; H2;
10000 BEGIN I←LEGAL(16,16,1); H2; END;
10100 H4;
10200 BEGIN I←LEGAL(10,10,1); H4; END;
10300 H6;
10400 BEGIN I←LEGAL(10,10,1); H6; END;
10500 H8;
10600 BEGIN I←LEGAL(10,10,1); H8; END;
10700 END; COMMENT END OF HDCP SETUP CASE;
10800 IF UPDA THEN UPDAT ELSE ARWLGO←0;
10900 HDCP←0;
11000 END;
11100
11200
11300
11400
11500
11600 BOOLEAN PROCEDURE UPSTRT;
11700 BEGIN COMMENT
11800 **********
11900 THE ROUTINE CAN BE USED TO SET HANDICAP STONES AND TO GIVE
12000 INITIAL GOODNESS VALUES TO EACH BOARD POINT. IT WILL START A
12100 A GAME FOR THE PLAYING PROGRAM AT ANY POSITION.
12200 **********;
12300 IF (ARWLGO≥0)∧¬SETSIDES THEN RETURN(FALSE);
12400 IF ¬SIMPLEMODE THEN SETOUTPUT;
12500 IF ARWLGO=2 THEN RETURN(TRUE);
12600 IF MOVENO=1 THEN BEGIN
12700 OUT(TT,"Handicap: "); HDCP←CVD(INPUT(TT,TT));
12800 IF HDCP<0 THEN HDCP←0; IF HDCP>9 THEN HDCP←9;
12900 IF PLAYSELF∧(HDCP>1) THEN TTYGUY←1-TTYGUY;
13000 END;
13100 UPDO(ARWLGO=1); IF (OUTPON>1)∧(ARWLGO=1) THEN DOOUTPUT;
13200 RETURN(TRUE);
13300 END;
13400
13500
13600
13700
13800
13900 PROCEDURE GETMOVES;
14000 BEGIN COMMENT
14100 **********
14200 THIS IS THE SCANNER FOR MOVE COORDINATES INPUT FROM THE TTY.
14300 IT SHOULD BE ABLE TO HANDLE ANY REASONABLE COMBINATION OF LETTERS
14400 AND NUMBERS. WE EXPECT EITHER 1-19 OR A-H,J-T TO SPECIFY A
14500 POSITION ALONG AN AXIS. WE DON'T CARE WHERE THE ORIGIN IS (AS
14600 LONG AS IT DOESN'T CHANGE!)
14700 **********;
14800 LABEL GETMORE,LOP1; INTEGER IVAL,JVAL;
14900 GETMORE:MBW;
15000 INSTRG←INPUT(TT,TT); IF BRCHAR='175 THEN RETURN; ARWLGO←0;
15100 LOP1:IVAL←COORDGET; JVAL←COORDGET;
15200 IF JVAL=0 THEN GO TO GETMORE;
15300 IF LGLMOV(IVAL,JVAL,1) THEN GO TO LOP1;
15400 END;
00100 PROCEDURE MAINPROG(STRING COMDSTR);
00200 BEGIN COMMENT
00300
00400 **********
00500 THIS IS THE MAIN PROGRAM FOR DIRECTING ALMOST EVERYTHING. IT CAN
00600 BE CALLED BY EVALTRACE IN GOEVAL DURING LOOKAHEAD. IT CAN ALSO
00700 BE USED AT ANY TIME BETWEEN MOVES AND AS AN EDITOR FOR TYPING
00800 IN OR LOOKING AT GAMES
00900 **********;
01000
01100 LABEL ECOMMANDS,NXTEDIT,EC1,CASEST;
01200 GO TO NXTEDIT;
01300 EC1:OUT(TT,CRLF);
01400 ECOMMANDS:HYDPOG(15); TYPLOC(-230,-490);
01500 OUT(TT,"*"); COMDSTR←INPUT(TT,TT);
01600 NXTEDIT:K←SCAN(COMDSTR,CHRSCN,BRCHAR);
01700 IF BRCHAR=0 THEN GO TO EC1;
01800 IF "A"≤BRCHAR≤"Z" THEN
01900 CASEST:CASE BRCHAR-"A" OF BEGIN
02000
02100
02200
02300
02400 BEGIN COMMENT A;
02500 COMMENT ****** AUTOMATIC MODE *******;
02600 INTEGER NEWGAME;LABEL REVERT,RESUME;
02700 SIMPLEMODE←TRUE;
02800 IF MOVENO>1 THEN BEGIN
02900 OUT(TT,"Type ""C"" to continue this game,"
03000 &" or anything else to start over: ");
03100 INSTR←INPUT(TT,TT);
03200 IF BRCHAR='175 THEN GO REVERT;
03300 IF INSTR="C" THEN GO RESUME END;
03400 OUT(TT,"Do you wish to start a NEW game or resume an OLD game?"
03500 &" (Type N or O): ");
03600 WHILE TRUE DO BEGIN
03700 INSTR←INPUT(TT,TT);
03800 IF INSTR="N" THEN BEGIN NEWGAME←1; DONE END
03900 ELSE IF INSTR="O" THEN BEGIN NEWGAME←0; DONE END
04000 ELSE IF BRCHAR='175 COMMENT <ALTMODE>; THEN GO REVERT
04100 ELSE OUT(TT,"Please type N or O: ");
04200 END;
04300 IF NEWGAME THEN OUT(TT,"Please type a name for this game: ")
04400 ELSE OUT(TT,"Please type the name you gave that game: ");
04500 GAMBUF←INPUT(TT,TT);
04600 IF BRCHAR='175 THEN GO REVERT;
04700 GAMBUF←GAMBUF&" ";
04800 GAMBUF←GAMBUF[1 FOR 20];
04900 SCRUPD;
05000 IF NEWGAME THEN BEGIN MAINPROG("EX"); DPYBRD END
05100 ELSE MAINPROG("EGCX");
05200 RESUME: COMDSTR←"O"&COMDSTR;
05300 GO TO NXTEDIT;
05400 REVERT: SIMPLEMODE←FALSE;
05500 OUT(TT,CRLF);
05600 COMDSTR←"N"&COMDSTR;
05700 END; COMMENT A;
05800
05900
06000 BRDOUT; COMMENT WRITE BOARD ON LSTO;
06100
06200
06300 BEGIN COMMENT C
06400 **********CONTINUE GAME TO MOVE XXX**********;
06500 STRING MOVELIST;
06600 IF ¬SIMPLEMODE THEN BEGIN
06700 OUT(TT,"THROUGH:"); STOPMV←CVD(INPUT(TT,TT))*2+19 END
06800 ELSE STOPMV←1000000;
06900 FFLAG←0; OUTPON↔FFLAG; STKSET←1; ARWLGO←0;
07000 IF STOPMV<NXTMOV THEN STOPMV←NXTMOV;
07100 IF LENGTH(GAMBUF)<STOPMV THEN BEGIN
07200 STOPMV←LENGTH(GAMBUF)-1;
07300 IF STOPMV<NXTMOV THEN GO TO ECOMMANDS;
07400 END;
07500 MOVELIST←GAMBUF[NXTMOV TO STOPMV+1];
07600 IF (NXTMOV=21)∧(GAMBUF[21 FOR 1]>50) THEN BEGIN
07700 HDCP←LOP(MOVELIST)-50; I←LOP(MOVELIST); UPDO(0);
07800 END;
07900 WHILE LENGTH(MOVELIST)>0 DO
08000 LGLMOV(LOP(MOVELIST),LOP(MOVELIST),0);
08100 OUTPON←FFLAG; DPYBRD;
08200 END; COMMENT CONTINUE;
08300
08400
08500 BEGIN COMMENT D
08600 **********DISPLAY HEADING INFORMATION**********;
08700 HEDOUT(TT); OUT(TT,CRLF);
08800 END;
08900
09000
09100 BEGIN COMMENT E
09200 **********ERASE (INITIALIZE) INTERNAL REPRESENTATION**********;
09300
09400 CONSET; COMMENT DEFINE INFLUENCE TABLE;
09500 FOR I←0 STEP 1 UNTIL 440 DO XGBOAR[I]←0;
09600 FOR I←21 STEP 21 UNTIL 399 DO BEGIN
09700 XGB1[I]←XGB1[I+20]←NONOCC+'177;
09800 FOR J←I+1 STEP 1 UNTIL I+19 DO XGB1[J]←BLANK;
09900 END;
10000 FOR I←0 STEP 1 UNTIL 20 DO XGB1[I]←XGB1[I+420]←NONOCC+'177;
10100 XSTRPT[126]←0;
10200 FOR K←0 STEP 1 UNTIL 125 DO XSTRPT[K]←K+1;
10300 XSTKSR[-1]←XSTKSR[-2]; IIIDPY←ARWLGO←0;
10400 MOVENO←1; NXTMOV←21;
10500 ARMIES[-3]←MSCVAL[1]; WALLS[-3]←MSCVAL[2];
10600 XGRPPT[-3]←MSCVAL[10];
10700 ARMIES[-1]←-(ARMIES[-2]←MSCVAL[3] LSH 18)+1;
10800 WALLS[-1]←-(WALLS[-2]←MSCVAL[4] LSH 18)+1;
10900 END; COMMENT EDITING START;
11000
11100
11200
11300
11400
11500 BEGIN COMMENT F
11600 **********FINISH AND FILE GAME**********;
11700
11800 IF OUTPON≠0 THEN BEGIN
11900 OUTPON←0; CLOSE(LSTO); RELEASE(LSTO);
12000 END;
12100 IF ODSKOPN(DSKO,GAMBUF[1 TO 6]&".GAM")=0 THEN BEGIN
12200 OUT(TT,"FILE OVERWRITE?");
12300 IF INPUT(TT,TT)≠"Y" THEN GO TO ECOMMANDS;
12400 OPENDISK(DSKO,0,GAMBUF[1 TO 6]&".GAM");
12500 END;
12600 OUT(DSKO,GAMBUF[1 TO ∞]);
12700 CLOSE(DSKO); RELEASE(DSKO); RETURN;
12800 END; COMMENT FINISH FILE;
12900
13000
13100
13200
13300
13400 BEGIN COMMENT G
13500 **********GET GAME FILE FROM DISK**********;
13600 OPEN(DSKI,"DSK",0,2,0,200,BRCHAR,ENDFIL);
13700 LOOKUP(DSKI,GAMBUF[1 TO 6]&".GAM",FFLAG);
13800 IF ¬FFLAG THEN BEGIN
13900 ENDFIL←0; GAMBUF←NULL;
14000 WHILE ¬ENDFIL DO GAMBUF←GAMBUF&INPUT(DSKI,DSKTAB);
14100 END ELSE OUT(TT,"CAN'T FIND FILE"&CRLF);
14200 CLOSE(DSKI); RELEASE(DSKI);
14300 END; COMMENT GAME GET;
14400
14500
14600
14700
14800
14900 IF OUTPON THEN BEGIN COMMENT H
15000 **********WRITE OUT COEFFICIENTS**********;
15100 OUT(LSTO,FF); HEDOUT(LSTO); OUT(LSTO,CRLF2); SETFORMAT(8,7);
15200 OUT(LSTO," MSCVAL DIFWGT ENMWGT FRDWGT ADJWGT MSCWGT"
15300 &" KLLWGT LIVWGT LBONUS"&CRLF2);
15400 FOR I←0 STEP 1 UNTIL 35 DO BEGIN
15500 IF (I MOD 10)=0 THEN OUT(LSTO,CRLF);
15600 OUT(LSTO,CVS(MSCVAL[I])&CVS(DIFWGT[I])&CVS(ENMWGT[I])
15700 &CVS(FRDWGT[I])&CVS(ADJWGT[I])&
15800 CVS(MSCWGT[I])&CVS(KLLWGT[I])&CVS(LIVWGT[I]));
15900 IF I≤17 THEN OUT(LSTO,CVS(LBONUS[I])&CRLF) ELSE OUT(LSTO,CRLF);
16000 END;
16100 SETFORMAT(0,7); OUT(LSTO,FF);
16200 END;
16300
16400
16500 ;COMMENT I;
16600 ;COMMENT J;
16700 ;COMMENT K;
16800
16900 BEGIN COMMENT L
17000 **********SET UP LIFE-AND-DEATH OF ONE OR ALL STRINGS**********;
17100 SETOUTPUT;
17200 OUT(TT,"STRING:"); LADDERSET(CVD(INPUT(TT,TT)));
17300 END;
17400
17500
17600 BEGIN COMMENT M
17700 **********MOVE INPUT FROM TTY**********;
17800 ARWLGO←-1; IF ¬UPSTRT THEN GO TO NXTEDIT; STKSET←0; GETMOVES;
17900 END;
18000
18100
18200
18300
18400
18500 BEGIN COMMENT N
18600 **********NAME THE CURRENT GAME BUFFER
18700 1ST 6 CHRS ARE GAME FILE NAME**********;
18800
18900 IF OUTPON THEN GO TO NXTEDIT;
19000 OUT(TT,"20-CHR NAME:"); STRNG←INPUT(TT,TT);
19100 IF LENGTH(STRNG)>0 THEN BEGIN
19200 WHILE LENGTH(STRNG)<20 DO STRNG←STRNG&" ";
19300 IF LENGTH(GAMBUF)≤20 THEN GAMBUF←STRNG[1 TO 20]
19400 ELSE GAMBUF←STRNG[1 TO 20]&GAMBUF[21 TO ∞];
19500 END;
19600 IF ¬ODSKOPN(LSTO,GAMBUF[1 TO 6]&".LGO") THEN BEGIN
19700 OUT(TT,"DEL OLD LST FILE?");
19800 IF INPUT(TT,TT)="Y" THEN OPENDISK(LSTO,0,GAMBUF[1 TO 6]&".LGO")
19900 ELSE OPENDISK(LSTO,0,GAMBUF[1 TO 6]&".TMP");
20000 END;
20100 OUTPON←1; RESTVALS;
20200 END; COMMENT NAMER;
20300
20400
20500
20600
20700
20800 BEGIN "O" COMMENT
20900 **********OPPONENT SITTING AT TTY**********;
21000
21100 LABEL PDPMOV,TTYMOV; INTEGER TEMP;
21200 IF ARWLGO≠2 THEN ARWLGO←0;
21300 IF ¬UPSTRT THEN GO TO NXTEDIT; STKSET←0; ARWLGO←2;
21400 IF (MOVENO LAND 1)=TTYGUY THEN GO TO TTYMOV;
21500
21600 PDPMOV:EVAL;
21700 IF GBFGET(SCRFRV[1])<MSCVAL[9] THEN BEGIN
21800 OUT(TT,"*** GAME OVER ***"); GO TO ECOMMANDS;
21900 END;
22000 MBW; OUT(TT,BLIJ(I←SCRFRV[1] DIV 21,J←SCRFRV[1] MOD 21));
22100 IF PLAYSELF THEN TTYGUY←1-TTYGUY;
22200 IF LGLMOV(I,J,1)=0 THEN GO TO ECOMMANDS;
22300 IF (OUTPON LAND '1000)=0 THEN OUT(TT,CRLF);
22400 IF SIMPLEMODE THEN BEGIN
22500 OPENDISK(DSKO,0,GAMBUF[1 TO 6]&".GAM");
22600 OUT(DSKO,GAMBUF[1 TO ∞]);
22700 CLOSE(DSKO); RELEASE(DSKO) END;
22800 IF PLAYSELF THEN
22900 IF MOVENO≥STOPMV THEN GO TO ECOMMANDS ELSE GO TO PDPMOV;
23000 TTYMOV:MBW;
23100 INSTRG←INPUT(TT,TT);
23200 IF BRCHAR='175 THEN BEGIN SIMPLEMODE←FALSE; GO TO NXTEDIT END;
23300 COMMENT <ALTMODE>,<U>,<U> WILL UNDO THE LAST EXCHANGE;
23400 XSTKSR[-1]←XSTKSR[-2];
23500 I←COORDGET; J←COORDGET;
23600 TEMP←LGLMOV(I,J,1);
23700 IF TEMP THEN GO TO PDPMOV ELSE GO TO TTYMOV;
23800 END; COMMENT OPPONENTS;
23900
24000
24100 ;COMMENT P;
24200
24300
24400 BEGIN COMMENT Q
24500 **********QUESTION THE DATE BASE**********;
24600 LABEL QLOP,QLOP1;
24700 QLOP:OUT(TT,"++"); INSTR←INPUT(TT,TT);
24800 IF LENGTH(INSTR)=0 ∨ BRCHAR='175 THEN GO TO NXTEDIT;
24900 QLOP1:K←SCAN(INSTR,CHRSCN,BRCHAR);
25000 IF BRCHAR=0 THEN GO TO QLOP;
25100 IF "A"≤BRCHAR≤"Z" THEN
25200 CASE BRCHAR-"A" OF BEGIN
25300
25400
25500 ;COMMENT A;
25600 BEGIN COMMENT BOARD POSITION;
25700 LABEL GBLOP;
25800 OUT(TT,"BITWRD"); STRNG←INPUT(TT,TT);
25900 IF LENGTH(STRNG)>0 THEN BEGIN
26000 BITWRD←CVO(STRNG);
26100 GBLOP: OUT(TT,"GB0123"); STRNG←INPUT(TT,TT);
26200 IF LENGTH(STRNG)>0 THEN GB0123←CVO(STRNG);
26300 IF (GB0123>3)∨(GB0123<0) THEN GO TO GBLOP;
26400 END;
26500 DPYBRD;
26600 END;
26700 HAFOUT; COMMENT CALCULATIONS;
26800 VARSETS(DIFWGT,"DIFWGT",35);
26900 VARSETS(ENMWGT,"ENMWGT",35);
27000 VARSETS(FRDWGT,"FRDWGT",35);
27100 ;COMMENT G;
27200 HOLDVALS; COMMENT HOLD COEFFICIENT AND GB2 VALUES;
27300 DPYDAT; COMMENT INFORMATION;
27400 VARSETS(ADJWGT,"ADJWGT",35);
27500 VARSETS(KLLWGT,"KLLWGT",35);
27600 VARSETS(LIVWGT,"LIVWGT",35);
27700 VARSETS(MSCVAL,"MSCVAL",35);
27800 VARSETS(MSCWGT,"MSCWGT",35);
27900 VARSETS(LBONUS,"LBONUS",17);
28000 BTSOUT; COMMENT PIECES OF XGB1;
28100 ;COMMENT Q;
28200 RESTVALS; COMMENT RESTORE COEFFICIENT AND GB2 VALUES;
28300 ;COMMENT S;
28400 ;COMMENT T;
28500 ;COMMENT U;
28600 DPYVAL; COMMENT VALUED MOVES LIST;
28700 ;COMMENT W;
28800 ;COMMENT X;
28900 ;COMMENT Y;
29000 ;COMMENT Z;
29100
29200
29300 END; COMMENT END OF CASE;
29400 HYDPOG(3); IIIDPY←0; COMMENT DISABLE BOARD CONTINUATION;
29500 GO TO QLOP1;
29600 END; COMMENT Q;
29700
29800
29900
30000
30100
30200 IF OUTPON THEN BEGIN COMMENT R
30300 **********GAME RECORD**********;
30400 INTEGER NSTRT;
30500 NSTRT←1; OUT(LSTO,FF&"GAME RECORD: ");
30600 HEDOUT(LSTO); OUT(LSTO,CRLF3);
30700 FOR IJ←21 STEP 20 UNTIL NXTMOV-2 DO BEGIN
30800 OUT(LSTO,"MOVE "); OUT(LSTO,CVS((NSTRT LSH -1)+1));
30900 OUT(LSTO,":"&TAB); NSTRT←NSTRT+20;
31000 L←IF NXTMOV≤IJ+18 THEN NXTMOV-2 ELSE IJ+18;
31100 IF (IJ=21)∧((K←GAMBUF[21 FOR 1]-50)>0) THEN BEGIN
31200 OUT(LSTO,CVS(K)); OUT(LSTO," HDCP"&TAB); K←23;
31300 END ELSE K←IJ;
31400 FOR K←K STEP 2 UNTIL L DO BEGIN
31500 OUT(LSTO,BLIJ(GAMBUF[K FOR 1],GAMBUF[K+1 FOR 1]));
31600 OUT(LSTO,TAB);
31700 END;
31800 OUT(LSTO,CRLF2);
31900 END;
32000 END;
32100
32200
32300
32400
32500
32600 BEGIN COMMENT S
32700 **********SET UP PREDICTED MOVE SCORES*****;
32800 ARWLGO←1; IF ¬UPSTRT THEN GO TO NXTEDIT; ARWLGO←0;
32900 END;
33000
33100
33200 ;COMMENT T;
33300
33400
33500 IF ¬STKSET ∧ (XSTKSR[-1]>XSTKSR[-2]) THEN BEGIN COMMENT
33600 **********UNMOVE THE LAST MOVE*****;
33700 UNMOVE; ARWLGO←0; IF OUTPON>1 THEN DOOUTPUT;
33800 NXTMOV←NXTMOV-2; MOVENO←MOVENO-1;
33900 REDOST(GAMBUF[NXTMOV FOR 1],GAMBUF[NXTMOV+1 FOR 1]);
34000 IF LENGTH(GAMBUF)=NXTMOV+1 THEN GAMBUF←GAMBUF[1 TO NXTMOV-1];
34100 END ELSE OUT(TT,"CAN'T");
34200
34300
34400 VALOUT(15); COMMENT HARD COPY OF VALUED MOVES;
34500
34600
34700 ;COMMENT W;
34800 RETURN;COMMENT X;
34900 ;COMMENT Y;
35000 ;COMMENT Z;
35100
35200
35300
35400
35500
35600 END; COMMENT FINISH OF THE CASE STATEMENT;
35700 GO TO NXTEDIT;
35800 END; COMMENT END OF CALLABLE MAIN PROGRAM;
35900
36000
36100
36200 CALL(CVSIX("GO"),"SETNAM");
36300 GARBAGE←0;
36400 FOR I←1 STEP 1 UNTIL '52 DO
36500 IF (I≠'12) ∧ (I≠'40) THEN GARBAGE←GARBAGE&I;
36600 FOR I←'72 STEP 1 UNTIL '100,'133 STEP 1 UNTIL '174,'176,'177 DO
36700 GARBAGE←GARBAGE&I;
36800
36900 FSSTRG←NULL; SETFORMAT(2,7);
37000 FOR I←1 STEP 1 UNTIL 5 DO BEGIN
37100 FOR J←1 STEP 1 UNTIL 9 DO FSSTRG←FSSTRG&CVS(J);
37200 FSSTRG←FSSTRG&" 0";
37300 END; SETFORMAT(0,7);
37400
37500 BREAKSET(TT,'12&'175,"I"); BREAKSET(TT,GARBAGE,"O");
37600 BREAKSET(CHRSCN,NULL,"X"); BREAKSET(DSKTAB,NULL,"I");
37700
37800 OPEN(TT,"TTY",1,2,2,100,BRCHAR,ENDFIL);
37900 TYPLOC(-200,-490);OUTPON←0;
38000
38100 SCRENV[0]←SCRFRV[0]←441; SCRENV[16]←SCRFRV[16]←442;
38200
38300 IF ¬RUNBEFORE THEN BEGIN RESTVALS;RUNBEFORE←TRUE END
38400 ELSE BEGIN
38500 OUT(TT,"This program is initialized in Automatic Mode.
38600 To revert to the more complicated but more general mode described
38700 in Jon Ryder's thesis, type <altmode>. Send complaints to MAL...
38800
38900
39000 ");
39100
39200 MAINPROG("A");
39300 END;
39400
39500
39600
39700
39800 END "GOMAIN"